perm filename CONTRL.SAI[SYS,HE]2 blob
sn#013495 filedate 1972-11-20 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 BEGIN "CONTRL"
00006 00003 STATBITS FOR COMMAND DECODER
00009 00004 HERE ARE OUR MESSAGE PROCEDURES
00018 00005 MAIN PROGRAM STARTS HERE
00021 00006 EXCUTE TYPED COMMANDS
00024 ENDMK
⊗;
BEGIN "CONTRL"
REQUIRE "HELIB.REL[1,3]" LIBRARY;
REQUIRE 100 SYSTEM_PDL;
REQUIRE 700 STRING_SPACE;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "EDGE[SYS,HE]" LOAD_MODULE;
REQUIRE "MISEDG[SYS,HE]" LOAD_MODULE;
REQUIRE "SCANER[SYS,HE]" LOAD_MODULE;
REQUIRE "INNER[SYS,HE]" LOAD_MODULE;
DEFINE CX="15",TTY="1", LPT="2",
CR="'15", LF="'12", CRLF="CR&LF", TAB="'11", TJOB="EQU(""TTY"",JOB)";
SAFE INTEGER ARRAY LPSFRE[1:1000];
PRELOAD_WITH "DISK","DEBUG","SETVAL","FIND","FIT","INSIDE",
"COMPACT","REJECT","RELOOK","FINE","GETDATA","GETVAL","GUNTRACE",
"START","GLBDMP";
SAFE STRING ARRAY COMND[0:CX];
PRELOAD_WITH 1,'12,'32,6,6,6,6,6,6,6,6,2,'36,1,4;
SAFE INTEGER ARRAY STATBITS[0:CX];
INTEGER I,J,BRK,ARG,TARG,STATUS,BITS, ARGT;
EXTERNAL INTEGER XSTRT, YSTRT, TVWORD, PTYDPY, DISSIZ,INIT;
BOOLEAN FLAGX, AFLAG, FLAG, FLAGY;
STRING ANS, VERB, ARGSTR, ARGTWO, DSKSTRING, INP;
LABEL INPT, INPTX, ERRCOM, ERRARG, XEQL;
EXTERNAL BOOLEAN ACCOMINIT, EDGINIT;
INTERNAL STRING JOB;
ITEMVAR IARG, T;
EXTERNAL BOOLEAN PROCEDURE LOOK(REFERENCE ITEMVAR ARG; REFERENCE INTEGER ING;
INTEGER X, Y);
EXTERNAL INTEGER PROCEDURE XGETD(ITEMVAR ARG; STRING JOB);
EXTERNAL PROCEDURE INITLPS(INTEGER A);
EXTERNAL PROCEDURE DISINT;
EXTERNAL BOOLEAN PROCEDURE INITDK(STRING NAME);
EXTERNAL PROCEDURE SEINT(INTEGER A, B, C, D, E);
EXTERNAL BOOLEAN PROCEDURE EDGE_KKP(REFERENCE ITEMVAR A;REFERENCE INTEGER S);
EXTERNAL PROCEDURE CURVE(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE INSUB(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE REJSUB(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE COMP(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE XFINE(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE FINSCN(SET BLOBS; INTEGER FILE; REFERENCE INTEGER STATUS);
EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY A);
EXTERNAL BOOLEAN PROCEDURE SUBLNK(STRING FOO);
EXTERNAL PROCEDURE INTINT(BOOLEAN A,B,C);
EXTERNAL INTEGER PROCEDURE SLINK(STRING NAME);
EXTERNAL PROCEDURE INITTV;
EXTERNAL PROCEDURE DEFLT;
EXTERNAL PROCEDURE INTWAIT;
COMMENT BITS IN STATBITS FOR COMMAND DECODER
1 NO ARGUMENTS
2 ONE ARGUMENT EXISTS
4 ARGUMENT IS NUMBER
10 SECOND ARGUMENT EXISTS
20 SECOND ARGUMENT IS NUMBER;
COMMENT GET VALUE OF VARIABLE;
SIMPLE PROCEDURE GETVAL(STRING ARGSTR; REFERENCE BOOLEAN FLAG);
BEGIN INTEGER I, FLG;
REAL J;
FLG ← FALSE;
IF FLAG←(I←SLINK(ARGSTR))>0 THEN
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,I;
MOVE 1,(1);
MOVEM 1,I;
MOVEM 1,J;
TLNE 1,'777000;
SETOM FLG;
END ELSE RETURN;
SETFORMAT(10,4);
OUTSTR((IF ¬FLG THEN (CVOS(I)&CVS(I)) ELSE (CVF(J)))&CRLF);
FLAG ← TRUE;
END;
SIMPLE INTEGER PROCEDURE FOOL(REAL A);
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,A;
END;
COMMENT SCAN ONE LINE FOR NEXT WORD OR NUMBER
STRING A IS EATEN AS SCANNED
B IS BREAK CHAR
FLAGX (GLOBAL) IS TRUE IF STRING IS A NUMBER
FLAGY (GLOBAL) IS TRUE IF A FLOATING POINT NUMBER IS SEEN;
SIMPLE STRING PROCEDURE SCN(REFERENCE STRING A; REFERENCE INTEGER B);
BEGIN STRING FOO, FA;
INTEGER C;
FA ← FOO ← SCAN(A,1,B);
SCAN(FA,2,C);
FLAGX ← ¬C;
SCAN(FA←FOO,3,C);
FLAGY←C;
RETURN(FOO);
END;
COMMENT HERE ARE OUR MESSAGE PROCEDURES;
COMMENT RESPONSE PROCEDURE;
SIMPLE PROCEDURE RESP(ITEMVAR ARG; INTEGER STATUS; STRING NAME);
IF TJOB THEN
BEGIN
AFLAG ← TRUE;
OUTSTR(NAME&(IF ARG=EVERY THEN " EVERY" ELSE " "
&CVS(CVN(ARG)))&" "&CVS(STATUS)&CRLF);
END ELSE ISSUE(5,"EDGE",JOB,
MESSAGE RESPONSE(NAME,CVN(ARG),STATUS));
DEFINE PROC(A,B)="
MESSAGE PROCEDURE A(ITEMVAR ARG);
BEGIN ITEMVAR T;
T ← ARG;
DO BEGIN
B(ARG,STATUS←0);
RESP(ARG,STATUS,""A"");
IF T=EVERY∧ARG≠NIL THEN ARG←T;
END UNTIL T≠EVERY∨ARG=NIL;
END";
MESSAGE PROCEDURE FIND(ITEMVAR ARG);
BEGIN ITEMVAR T;
T ← ARG;
DO BEGIN
EDGE_KKP(ARG,STATUS);
IF T=EVERY∧ARG≠NIL THEN ARG←T;
END UNTIL T≠EVERY∨ARG=NIL;
RESP(NIL,-1,"FIND");
IF ARG=NIL THEN XSTRT←YSTRT←0;
END;
MESSAGE PROCEDURE GUNTRACE(SET BLOBS;INTEGER FILE);
BEGIN BOOLEAN STATUS;
FINSCN(BLOBS, FILE, STATUS);
RESP(NIL,STATUS,"GUNTRACE");
END;
PROC(FIT,CURVE);
PROC(INSIDE,INSUB);
PROC(COMPACT,COMP);
PROC(REJECT,REJSUB);
PROC(FINE,XFINE);
MESSAGE PROCEDURE RELOOK(ITEMVAR ARG; INTEGER X,Y);
BEGIN
LOOK(ARG,STATUS,X,Y);
RESP(ARG,STATUS,"RELOOK");
END;
SIMPLE MESSAGE PROCEDURE XEQ(STRING ARGSTR; REFERENCE BOOLEAN FLAG);
IF EQU(ARGSTR,"START") THEN XSTRT←YSTRT←0 ELSE FLAG←¬SUBLNK(ARGSTR);
SIMPLE MESSAGE PROCEDURE DEBUG(STRING ARGSTR,ARGTWO;REFERENCE BOOLEAN FLAG);
BEGIN INTEGER I;
IF EQU(ARGTWO,"ON") THEN I ← 4 ELSE IF
EQU(ARGTWO,"OFF") THEN I←3 ELSE BEGIN FLAG←FALSE;RETURN;END;
FLAG ← ¬SUBLNK(ARGSTR[1 FOR I]&ARGTWO);
END;
SIMPLE MESSAGE PROCEDURE SETVAL(STRING AR; INTEGER A; REFERENCE BOOLEAN F);
BEGIN
EDGINIT ← FALSE;
IF F ← (I ← SLINK(AR))>0 THEN
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,A;
MOVE 2,I;
MOVEM 1,(2);
END;
END;
MESSAGE PROCEDURE GETDATA(ITEMVAR ARG; REFERENCE BOOLEAN FLAG);
BEGIN
FLAG ← ¬XGETD(ARG, JOB);
END;
INTERNAL PROCEDURE RESTART;
BEGIN
AFLAG←TRUE;
DISINT;
SEINT(0,0,0,0, 0);
INITLPS(GIOWD(LPSFRE));
INITTV;
INP ← NULL;
DEFLT;
END;
SIMPLE MESSAGE PROCEDURE DISK(STRING NAME; REFERENCE BOOLEAN FLAG);
FLAG ← INITDK(NAME);
COMMENT MAIN PROGRAM STARTS HERE;
PTYDPY ← DISDEV;
ACCOMINIT ← FALSE;
SETBREAK(1,LF&" ,",NULL,"I");
SETBREAK(2,"0123456789.-",NULL,"X");
SETBREAK(3,".",NULL,"I");
SETBREAK(4,LF,"","IA");
SETBREAK(5," ",NULL,"XR");
TVWORD ← 0;
PUT_DATA(0,0,"EDGE");
YES_EDGE ← TRUE;
INIT ← FALSE;
INTINT(TRUE,FALSE,TRUE);
RESTART;
INPT: WHILE (I ← GET_ENTRY('40120,"","EDGE","")) DO
BEGIN
JOB ← GET_DATA(1,I);
I ← QUEUE('600,I);
END;
IF AFLAG THEN BEGIN OUTSTR("*"&CRLF); AFLAG ← FALSE; END;
WHILE LENGTH(ANS←INCHSL(FLAGX))∧¬FLAGX DO
BEGIN INP←INP&ANS&LF;ANS←NULL;END;
IF ¬LENGTH(INP) THEN GO TO XEQL;
JOB←"TTY";
AFLAG ← TRUE;
WHILE LENGTH(ANS←SCAN(INP,4,BRK)) DO
BEGIN
IF ¬LENGTH(VERB←SCN(ANS,BRK)) THEN GO TO INPTX;
FOR I ← 0 STEP 1 UNTIL CX DO IF EQU(VERB,COMND[I]) THEN DONE;
IF I>CX THEN GO TO ERRCOM;
BITS ← STATBITS[I];
IF BITS LAND 2 THEN
BEGIN
IF BRK=LF THEN GO TO ERRARG ELSE ARGSTR←SCN(ANS,BRK);
IF BITS LAND 4 THEN IF FLAGX THEN
ARG←(IF FLAGY THEN FOOL(REALSCAN(ARGSTR,LF))
ELSE CVD(ARGSTR)) ELSE GO ERRARG ELSE
ARGSTR ← ARGSTR[1 FOR 6];
IF BITS LAND '10 THEN
BEGIN
IF BRK=LF THEN GO TO ERRARG ELSE
ARGTWO←SCN(ANS,BRK);
IF BITS LAND '20 THEN IF FLAGX THEN
ARGT←(IF FLAGY THEN
FOOL(REALSCAN(ARGTWO,LF))
ELSE CVD(ARGTWO)) ELSE GO TO ERRARG
ELSE ARGTWO ← ARGTWO[1 FOR 6];
END;
END;
IARG ← IF ARG>0 THEN CVI(ARG) ELSE IF ARG=0 THEN NIL ELSE EVERY;
FLAG ← TRUE;
COMMENT EXCUTE TYPED COMMANDS;
CASE I OF
BEGIN
BEGIN
IF LENGTH(ANS) THEN
BEGIN
INP ← SCAN(ANS,5,BRK);
DSKSTRING ← ANS[1 TO ∞-1];
END;
DISK(DSKSTRING,FLAG);
IF ¬FLAG THEN
OUTSTR(CRLF&DSKSTRING&" NOT FOUND"&CRLF);
END;
DEBUG(ARGSTR, ARGTWO, FLAG);
SETVAL(ARGSTR,ARGT, FLAG);
FIND(IARG);
FIT(IARG);
INSIDE(IARG);
COMPACT(IARG);
REJECT(IARG);
RELOOK(IARG,0,0);
FINE(IARG);
GETDATA(IF ARG<0 THEN EVERY ELSE CVI(ARG),FLAG);
GETVAL(ARGSTR,FLAG);
GUNTRACE({IARG},ARGT);
YSTRT ← XSTRT ← 0;
IF YES_CUR THEN ISSUE(7,"EDGE","CURVE",
MESSAGE GLBDMP(IF IARG=EVERY THEN BLOBS
ELSE {IARG})) ELSE
OUTSTR("CURVE FITTER NOT AVAILABLE"&CRLF);
END;
IF ¬FLAG THEN
ERRARG: OUTSTR("ARG ERR"&TAB&ANS&CRLF);
INPTX: END;
GO TO INPT;
XEQL: IF GET_ENTRY('40120,NULL,"EDGE",NULL) THEN GO TO INPT;
IF LENGTH(ANS←INCHSL(FLAGX))∧¬FLAGX THEN
BEGIN
INP←INP&ANS&LF;
GO TO INPT;
END;
INTWAIT;
GO TO INPT;
ERRCOM: IF SUBLNK(VERB) THEN OUTSTR("COM ERR "&VERB&CRLF);
GO TO INPT;
END;